[PATCH] <short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

Bug-Debian: https://bugs.debian.org/1135720

Gbp-Pq: Name Version_2_7_2pre22

diff --git a/Makefile.am b/Makefile.am
index 892d3b0a840cd4f4d4afb4d0bfc072cfedad3d8f..234a2c5695338198c67a61ab0264626d1c8a7ccd 100644 (file)
--- a/Makefile.am
+++ b/Makefile.am
@@ -271,7 +271,10 @@ unixport/raw_%: unixport/lib%.a $(FF) $(LF)
                ( echo Relinking raw image for mac arm && \
                  $(CC) \
                      $$(otool -l $@ | bin/mac_arm_relink ps=$(SEGMENT_ALIGNMENT_BITS) base=$(TEXT_BASE)) \
-                     $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $(FF) $< $(LF) $(LIBS))
+                     $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $(FF) $< $(LF) $(LIBS) && \
+                 ("$$(printf '%s\n1167\n' $$(ld -v  2>&1 | head -n 1 | awk '{print $$2}' | cut -f2 -d: | cut -d- -f2 | cut -d\. -f1) | sort -V |head -n 1)"  != "1167" || \
+                       ( printf '\x00\x00\x00\x00\x01\x00\x00\x00' | dd of=$@ bs=1 seek=64 conv=notrunc && \
+                         codesign -s - --force $@ )))
 
 unixport/gcl_cmpnopt_gcl_gprof.lsp unixport/gcl_cmpnopt_ansi_gcl_gprof.lsp:\
 unixport/gcl_cmpnopt_%_gprof.lsp: unixport/gcl_cmpnopt_%.lsp

diff --git a/Makefile.in b/Makefile.in
index 8291c2421c721e71f8b0c09452353d41b05089b3..14686a75fed077c26712e76671b6a913f1cb544e 100644 (file)
--- a/Makefile.in
+++ b/Makefile.in
@@ -4583,7 +4583,10 @@ unixport/raw_%: unixport/lib%.a $(FF) $(LF)
                ( echo Relinking raw image for mac arm && \
                  $(CC) \
                      $$(otool -l $@ | bin/mac_arm_relink ps=$(SEGMENT_ALIGNMENT_BITS) base=$(TEXT_BASE)) \
-                     $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $(FF) $< $(LF) $(LIBS))
+                     $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $(FF) $< $(LF) $(LIBS) && \
+                 ("$$(printf '%s\n1167\n' $$(ld -v  2>&1 | head -n 1 | awk '{print $$2}' | cut -f2 -d: | cut -d- -f2 | cut -d\. -f1) | sort -V |head -n 1)"  != "1167" || \
+                       ( printf '\x00\x00\x00\x00\x01\x00\x00\x00' | dd of=$@ bs=1 seek=64 conv=notrunc && \
+                         codesign -s - --force $@ )))
 
 unixport/gcl_cmpnopt_gcl_gprof.lsp unixport/gcl_cmpnopt_ansi_gcl_gprof.lsp:\
 unixport/gcl_cmpnopt_%_gprof.lsp: unixport/gcl_cmpnopt_%.lsp

diff --git a/cmpnew/gcl_cmpeval.lsp b/cmpnew/gcl_cmpeval.lsp
index 4bdb6c82cd8cdafb2eab2050233f1dbd76f2098b..e23621c4904445e3c3426af04c2e32edf90b8abc 100644 (file)
--- a/cmpnew/gcl_cmpeval.lsp
+++ b/cmpnew/gcl_cmpeval.lsp
@@ -88,9 +88,7 @@
                    (or 
                     (c1constant-value val nil)
                     (when (functionp val)
-                      (multiple-value-bind (s c n) (fle val)
-                        (declare (ignore c))
-                        (c1function (list (or n s)))))
+                      (c1function (list (fle val))))
                     `(location ,(make-info :type (object-type val)) (VV ,(add-constant form))))))
                                        ;                 ((c1var form))))
                  ((c1expr-avct (c1var form))))) ;FIXME pcl

diff --git a/configure b/configure
index 37ffbdffec6a25fe681cde21ee961c2a5d805a4f..6e928787965f2127659985f165a9371e4c8f1488 100755 (executable)
--- a/configure
+++ b/configure
@@ -7342,7 +7342,7 @@ if test ${enable_saved_pre_image_span+y}
 then :
   enableval=$enable_saved_pre_image_span; SAVED_PRE_IMAGE_SPAN=$enableval
 else case e in #(
-  e) SAVED_PRE_IMAGE_SPAN=0x100000000 ;;
+  e) SAVED_PRE_IMAGE_SPAN=0xFFF00000 ;;
 esac
 fi
 

diff --git a/configure.ac b/configure.ac
index eee96c6fec1d7969f5ebac5f3aa7bfd0906ebf07..999f5cce40c66b7c34b41f4c4eafa868503ba40e 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -360,7 +360,7 @@ case $use in
 
        #Support libboot option
        AC_ARG_ENABLE([saved_pre_image_span],[  --enable-saved_pre_image_span=0x.... set address span for saved pre images],
-          [SAVED_PRE_IMAGE_SPAN=$enableval],[SAVED_PRE_IMAGE_SPAN=0x100000000])
+          [SAVED_PRE_IMAGE_SPAN=$enableval],[SAVED_PRE_IMAGE_SPAN=0xFFF00000])
        AC_DEFINE_UNQUOTED(SAVED_PRE_IMAGE_SPAN,$SAVED_PRE_IMAGE_SPAN,[address span for saved pre images])
 
        AC_ARG_ENABLE([saved_image_span],[  --enable-saved_image_span=0x.... set address span for saved images],

diff --git a/git.tag b/git.tag
index c1dfabcceb7a2fbce3ad6739b881159e6eaf7675..243ec70bef99a49a3777140970b603aeb0bc88ba 100644 (file)
--- a/git.tag
+++ b/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre21"
+"Version_2_7_2pre22"

diff --git a/lsp/gcl_fpe.lsp b/lsp/gcl_fpe.lsp
index a4718ed2db3ff64e7b55129dcd3d259782b0ed3a..b45a896a39ca0d6237b115a5d84cb054324c63da 100644 (file)
--- a/lsp/gcl_fpe.lsp
+++ b/lsp/gcl_fpe.lsp
@@ -2,7 +2,7 @@
 (in-package :fpe)
 
 (import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double
-                                     fetestexcept feclearexcept
+                                     fetestexcept feclearexcept address
                                      *fixnum *ushort *uint fun-name
                                      si-class-direct-subclasses si-class-name si-find-class
                                      +fe-list+ +mc-context-offsets+ floating-point-error 
@@ -132,11 +132,11 @@
 
 #.`(let ((fpe-enabled 0)(fpe-set 0))
      #+no-sigfpe
-     (defun flush-floating-point-exceptions nil
+     (defun flush-floating-point-exceptions (name args &optional (fun (symbol-function name)))
        (let ((x (fetestexcept fpe-set)))
         (unless (zerop x)
           (feclearexcept x)
-          (floating-point-error x 0 0))))
+          (floating-point-error x (list* fun "unknown" name args) 0))))
      (defun break-on-floating-point-exceptions 
         (&key suspend no-flush
            ,@(mapcar (lambda (x) `(,(car x) (logtest ,(caddr x) fpe-enabled))) +fe-list+)
@@ -168,17 +168,23 @@
          :initial-value nil)
       'arithmetic-error))
         
-(defun floating-point-error (code addr context)
+(defun floating-point-error (code addr context &aux (l (listp addr)))
   (break-on-floating-point-exceptions :suspend t :no-flush t)
   (restart-case
    (unwind-protect
-       (let* ((fun (function-by-address addr))(m (read-instruction addr context)))
-        ((lambda (&rest r) (apply 'error (if (find-package :conditions) r (list (format nil "~s" r)))))
+       (let* ((fun (if l (pop addr) (function-by-address addr)))
+              (m (if l addr (read-instruction addr context)))
+              (addr (if l (address fun) addr)))
+        ((lambda (&rest r)
+           (apply 'error (if (find-package :conditions) r (list (format nil "~s" r)))))
          (code-condition code)
-         :operation (list :insn (pop m) :op (pop m) :fun fun :addr addr) :operands m :function-name (when fun (fun-name fun))))
+         :operation (list :insn (pop m) :op (pop m) :fun fun :addr addr)
+         :operands m
+         :function-name (when fun (fun-name fun))))
      (break-on-floating-point-exceptions :no-flush t))
-   (continue nil :report (lambda (s) (format s "Continue disabling floating point exception trapping"))
-            (apply 'break-on-floating-point-exceptions
-                   :no-flush t
-                   (mapcan (lambda (x) (list x nil))
-                           (break-on-floating-point-exceptions :no-flush t))))))
+    (continue nil
+      :report (lambda (s) (format s "Continue disabling floating point exception trapping"))
+      (apply 'break-on-floating-point-exceptions
+            :no-flush t
+            (mapcan (lambda (x) (list x nil))
+                    (break-on-floating-point-exceptions :no-flush t))))))